home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / TUT10.ZIP / GFX.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-05  |  11KB  |  389 lines
  1. Unit GFX;
  2.  
  3.  
  4. INTERFACE
  5.  
  6. USES crt;
  7. CONST VGA = $A000;
  8.  
  9. TYPE Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
  10.      VirtPtr = ^Virtual;                  { Pointer to the virtual screen }
  11.  
  12. VAR Virscr : VirtPtr;                     { Our first Virtual screen }
  13.     Vaddr  : word;                        { The segment of our virtual screen}
  14.  
  15. Procedure SetMCGA;
  16.    { This procedure gets you into 320x200x256 mode. }
  17. Procedure SetText;
  18.    { This procedure returns you to text mode.  }
  19. Procedure Cls (Where:word;Col : Byte);
  20.    { This clears the screen to the specified color }
  21. Procedure SetUpVirtual;
  22.    { This sets up the memory needed for the virtual screen }
  23. Procedure ShutDown;
  24.    { This frees the memory used by the virtual screen }
  25. procedure flip(source,dest:Word);
  26.    { This copies the entire screen at "source" to destination }
  27. Procedure Pal(Col,R,G,B : Byte);
  28.    { This sets the Red, Green and Blue values of a certain color }
  29. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  30.   { This gets the Red, Green and Blue values of a certain color }
  31. procedure WaitRetrace;
  32.    {  This waits for a vertical retrace to reduce snow on the screen }
  33. Procedure Hline (x1,x2,y:word;col:byte;where:word);
  34.    { This draws a horizontal line from x1 to x2 on line y in color col }
  35. Procedure Line(a,b,c,d:integer;col:byte;where:word);
  36.   { This draws a solid line from a,b to c,d in colour col }
  37. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  38.    { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  39.      in color col }
  40. Function rad (theta : real) : real;
  41.    {  This calculates the degrees of an angle }
  42. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
  43.    { This puts a pixel on the screen by writing directly to memory. }
  44. Function Getpixel (X,Y : Integer; where:word) :Byte;
  45.    { This gets the pixel on the screen by reading directly to memory. }
  46.  
  47.  
  48. IMPLEMENTATION
  49.  
  50. {──────────────────────────────────────────────────────────────────────────}
  51. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  52. BEGIN
  53.   asm
  54.      mov        ax,0013h
  55.      int        10h
  56.   end;
  57. END;
  58.  
  59. {──────────────────────────────────────────────────────────────────────────}
  60. Procedure SetText;  { This procedure returns you to text mode.  }
  61. BEGIN
  62.   asm
  63.      mov        ax,0003h
  64.      int        10h
  65.   end;
  66. END;
  67.  
  68. {──────────────────────────────────────────────────────────────────────────}
  69. Procedure Cls (Where:word;Col : Byte); assembler;
  70.    { This clears the screen to the specified color }
  71. asm
  72.    push    es
  73.    mov     cx, 32000;
  74.    mov     es,[where]
  75.    xor     di,di
  76.    mov     al,[col]
  77.    mov     ah,al
  78.    rep     stosw
  79.    pop     es
  80. End;
  81.  
  82. {──────────────────────────────────────────────────────────────────────────}
  83. Procedure SetUpVirtual;
  84.    { This sets up the memory needed for the virtual screen }
  85. BEGIN
  86.   GetMem (VirScr,64000);
  87.   vaddr := seg (virscr^);
  88. END;
  89.  
  90. {──────────────────────────────────────────────────────────────────────────}
  91. Procedure ShutDown;
  92.    { This frees the memory used by the virtual screen }
  93. BEGIN
  94.   FreeMem (VirScr,64000);
  95. END;
  96.  
  97. {──────────────────────────────────────────────────────────────────────────}
  98. procedure flip(source,dest:Word); assembler;
  99.   { This copies the entire screen at "source" to destination }
  100. asm
  101.   push    ds
  102.   mov     ax, [Dest]
  103.   mov     es, ax
  104.   mov     ax, [Source]
  105.   mov     ds, ax
  106.   xor     si, si
  107.   xor     di, di
  108.   mov     cx, 32000
  109.   rep     movsw
  110.   pop     ds
  111. end;
  112.  
  113. {──────────────────────────────────────────────────────────────────────────}
  114. Procedure Pal(Col,R,G,B : Byte); assembler;
  115.   { This sets the Red, Green and Blue values of a certain color }
  116. asm
  117.    mov    dx,3c8h
  118.    mov    al,[col]
  119.    out    dx,al
  120.    inc    dx
  121.    mov    al,[r]
  122.    out    dx,al
  123.    mov    al,[g]
  124.    out    dx,al
  125.    mov    al,[b]
  126.    out    dx,al
  127. end;
  128.  
  129. {──────────────────────────────────────────────────────────────────────────}
  130. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  131.   { This gets the Red, Green and Blue values of a certain color }
  132. Var
  133.    rr,gg,bb : Byte;
  134. Begin
  135.    asm
  136.       mov    dx,3c7h
  137.       mov    al,col
  138.       out    dx,al
  139.  
  140.       add    dx,2
  141.  
  142.       in     al,dx
  143.       mov    [rr],al
  144.       in     al,dx
  145.       mov    [gg],al
  146.       in     al,dx
  147.       mov    [bb],al
  148.    end;
  149.    r := rr;
  150.    g := gg;
  151.    b := bb;
  152. end;
  153.  
  154. {──────────────────────────────────────────────────────────────────────────}
  155. procedure WaitRetrace; assembler;
  156.   {  This waits for a vertical retrace to reduce snow on the screen }
  157. label
  158.   l1, l2;
  159. asm
  160.     mov dx,3DAh
  161. l1:
  162.     in al,dx
  163.     and al,08h
  164.     jnz l1
  165. l2:
  166.     in al,dx
  167.     and al,08h
  168.     jz  l2
  169. end;
  170.  
  171. {──────────────────────────────────────────────────────────────────────────}
  172. Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler;
  173.   { This draws a horizontal line from x1 to x2 on line y in color col }
  174. asm
  175.   mov   ax,where
  176.   mov   es,ax
  177.   mov   ax,y
  178.   mov   di,ax
  179.   shl   ax,8
  180.   shl   di,6
  181.   add   di,ax
  182.   add   di,x1
  183.  
  184.   mov   al,col
  185.   mov   ah,al
  186.   mov   cx,x2
  187.   sub   cx,x1
  188.   shr   cx,1
  189.   jnc   @start
  190.   stosb
  191. @Start :
  192.   rep   stosw
  193. end;
  194.  
  195. {──────────────────────────────────────────────────────────────────────────}
  196. Procedure Line(a,b,c,d:integer;col:byte;where:word);
  197.   { This draws a solid line from a,b to c,d in colour col }
  198.   function sgn(a:real):integer;
  199.   begin
  200.        if a>0 then sgn:=+1;
  201.        if a<0 then sgn:=-1;
  202.        if a=0 then sgn:=0;
  203.   end;
  204. var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
  205. begin
  206.      u:= c - a;
  207.      v:= d - b;
  208.      d1x:= SGN(u);
  209.      d1y:= SGN(v);
  210.      d2x:= SGN(u);
  211.      d2y:= 0;
  212.      m:= ABS(u);
  213.      n := ABS(v);
  214.      IF NOT (M>N) then
  215.      BEGIN
  216.           d2x := 0 ;
  217.           d2y := SGN(v);
  218.           m := ABS(v);
  219.           n := ABS(u);
  220.      END;
  221.      s := m shr 1;
  222.      FOR i := 0 TO m DO
  223.      BEGIN
  224.           putpixel(a,b,col,where);
  225.           s := s + n;
  226.           IF not (s<m) THEN
  227.           BEGIN
  228.                s := s - m;
  229.                a:= a + d1x;
  230.                b := b + d1y;
  231.           END
  232.           ELSE
  233.           BEGIN
  234.                a := a + d2x;
  235.                b := b + d2y;
  236.           END;
  237.      end;
  238. END;
  239.  
  240.  
  241. {──────────────────────────────────────────────────────────────────────────}
  242. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  243.   { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  244.     in color col }
  245. var
  246.   x:integer;
  247.   mny,mxy:integer;
  248.   mnx,mxx,yc:integer;
  249.   mul1,div1,
  250.   mul2,div2,
  251.   mul3,div3,
  252.   mul4,div4:integer;
  253.  
  254. begin
  255.   mny:=y1; mxy:=y1;
  256.   if y2<mny then mny:=y2;
  257.   if y2>mxy then mxy:=y2;
  258.   if y3<mny then mny:=y3;
  259.   if y3>mxy then mxy:=y3;    { Choose the min y mny and max y mxy }
  260.   if y4<mny then mny:=y4;
  261.   if y4>mxy then mxy:=y4;
  262.  
  263.   if mny<0 then mny:=0;
  264.   if mxy>199 then mxy:=199;
  265.   if mny>199 then exit;
  266.   if mxy<0 then exit;        { Verticle range checking }
  267.  
  268.   mul1:=x1-x4; div1:=y1-y4;
  269.   mul2:=x2-x1; div2:=y2-y1;
  270.   mul3:=x3-x2; div3:=y3-y2;
  271.   mul4:=x4-x3; div4:=y4-y3;  { Constansts needed for intersection calc }
  272.  
  273.   for yc:=mny to mxy do
  274.     begin
  275.       mnx:=320;
  276.       mxx:=-1;
  277.       if (y4>=yc) or (y1>=yc) then
  278.         if (y4<=yc) or (y1<=yc) then   { Check that yc is between y1 and y4 }
  279.           if not(y4=y1) then
  280.             begin
  281.               x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis }
  282.               if x<mnx then
  283.                 mnx:=x;
  284.               if x>mxx then
  285.                 mxx:=x;       { Set point as start or end of horiz line }
  286.             end;
  287.       if (y1>=yc) or (y2>=yc) then
  288.         if (y1<=yc) or (y2<=yc) then   { Check that yc is between y1 and y2 }
  289.           if not(y1=y2) then
  290.             begin
  291.               x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis }
  292.               if x<mnx then
  293.                 mnx:=x;
  294.               if x>mxx then
  295.                 mxx:=x;       { Set point as start or end of horiz line }
  296.             end;
  297.       if (y2>=yc) or (y3>=yc) then
  298.         if (y2<=yc) or (y3<=yc) then   { Check that yc is between y2 and y3 }
  299.           if not(y2=y3) then
  300.             begin
  301.               x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis }
  302.               if x<mnx then
  303.                 mnx:=x;
  304.               if x>mxx then
  305.                 mxx:=x;       { Set point as start or end of horiz line }
  306.             end;
  307.       if (y3>=yc) or (y4>=yc) then
  308.         if (y3<=yc) or (y4<=yc) then   { Check that yc is between y3 and y4 }
  309.           if not(y3=y4) then
  310.             begin
  311.               x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis }
  312.               if x<mnx then
  313.                 mnx:=x;
  314.               if x>mxx then
  315.                 mxx:=x;       { Set point as start or end of horiz line }
  316.             end;
  317.       if mnx<0 then
  318.         mnx:=0;
  319.       if mxx>319 then
  320.         mxx:=319;          { Range checking on horizontal line }
  321.       if mnx<=mxx then
  322.         hline (mnx,mxx,yc,color,where);   { Draw the horizontal line }
  323.     end;
  324.   end;
  325.  
  326. {──────────────────────────────────────────────────────────────────────────}
  327. Function rad (theta : real) : real;
  328.   {  This calculates the degrees of an angle }
  329. BEGIN
  330.   rad := theta * pi / 180
  331. END;
  332.  
  333. {──────────────────────────────────────────────────────────────────────────}
  334. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
  335.   { This puts a pixel on the screen by writing directly to memory. }
  336. Asm
  337.   mov     ax,[where]
  338.   mov     es,ax
  339.   mov     bx,[X]
  340.   mov     dx,[Y]
  341.   mov     di,bx
  342.   mov     bx, dx                  {; bx = dx}
  343.   shl     dx, 8
  344.   shl     bx, 6
  345.   add     dx, bx                  {; dx = dx + bx (ie y*320)}
  346.   add     di, dx                  {; finalise location}
  347.   mov     al, [Col]
  348.   stosb
  349. End;
  350.  
  351. {──────────────────────────────────────────────────────────────────────────}
  352. Function Getpixel (X,Y : Integer; where:word):byte; assembler;
  353.   { This puts a pixel on the screen by writing directly to memory. }
  354. Asm
  355.   mov     ax,[where]
  356.   mov     es,ax
  357.   mov     bx,[X]
  358.   mov     dx,[Y]
  359.   mov     di,bx
  360.   mov     bx, dx                  {; bx = dx}
  361.   shl     dx, 8
  362.   shl     bx, 6
  363.   add     dx, bx                  {; dx = dx + bx (ie y*320)}
  364.   add     di, dx                  {; finalise location}
  365.   lodsb
  366. End;
  367.  
  368. {──────────────────────────────────────────────────────────────────────────}
  369. Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  370.   { This loads the cel 'filename' into the pointer scrptr }
  371. var
  372.   Fil : file;
  373.   Buf : array [1..1024] of byte;
  374.   BlocksRead, Count : word;
  375. begin
  376.   assign (Fil, FileName);
  377.   reset (Fil, 1);
  378.   BlockRead (Fil, Buf, 800);    { Read and ignore the 800 byte header }
  379.   Count := 0; BlocksRead := $FFFF;
  380.   while (not eof (Fil)) and (BlocksRead <> 0) do begin
  381.     BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead);
  382.     Count := Count + 1024;
  383.   end;
  384.   close (Fil);
  385. end;
  386.  
  387.  
  388. BEGIN
  389. END.